home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
dbms_mag
/
9105
/
lief1.may
< prev
next >
Wrap
Text File
|
1991-03-25
|
6KB
|
189 lines
* Program: VIRTUAL.PRG
Date: February 1991
Purpose: Demonstrate 5.0 virtual screen trickery with
BEGINPAINT() and ENDPAINT()
Caveat: These two functions are undocumented, and are
therefore subject to change at any time without
a moment's notice.
Compile with: Clipper virtual /n/w*/
#include "box.ch"
#include "inkey.ch"
#include "fileio.ch"
#translate drawbox( <color>, <t>, <l>, <b>, <r>, <fill> ) => ;
setcolor( <color> ) ; @ <t>,<l>,<b>,<r> box B_SINGLE + <fill>
#define FLICKER .F.
#define NOFLICKER .T.
function main_stub
Blinkey()
Curtains()
inkey(5)
Movement(FLICKER)
Movement(NOFLICKER)
return nil
/* Function: BLINKEY()
Purpose: Flashing alternate screens
to drive you crazy*/
function blinkey
local x, screens := {}
beginpaint()
setcursor(0)
drawbox('w/b', 0, 0, maxrow(), maxcol(), '1')
drawbox('w/r', 5, 5, 17, 74, '2')
aadd(screens, savescreen(0, 0, maxrow(), maxcol()))
drawbox('w/r', 0, 0, maxrow(), maxcol(), '1')
drawbox('w/b', 5, 5, 17, 74, '2')
aadd(screens, savescreen(0, 0, maxrow(), maxcol()))
endpaint()
do while inkey(.2) = 0
x = if(x = 1, 2, 1)
beginpaint()
restscreen(0, 0, maxrow(), maxcol(), screens[x])
endpaint()
enddo
return nil
/* End Function BLINKEY() */
/* Function: CURTAINS()
Purpose: Demonstrate spreading curtains effect*/
function Curtains
local x
beginpaint()
setcursor(0)
drawbox('w/b', 0, 0, maxrow(), maxcol(), ' ')
drawbox('w/r', 5, 5, 19, 74, ' ')
drawbox('w/rb', 9, 15, 16, 64, ' ')
drawbox('n/bg', 11, 24, 14, 55, ' ')
@ 12, 32 say "The Killer App"
@ 13, 26 say "Copyright (c) 1991 Joe Blow"
save_drape('title.scr')
setcolor('w/n')
cls
endpaint()
inkey(0)
pull_drape('title.scr')
return nil
/* End Function CURTAINS() */
/* Function: PULL_DRAPE()
Purpose: Draw title screen from specified memory file
Excerpted from the Grumpfish Library*/
function Pull_Drape(cfile)
local nhandle, screen_ := {}, buffer, xx, yy, midpoint, ;
mwidth, mlength, oldcurs := setcursor(0), ndelay := 10
if file(cfile)
if ( nhandle := fopen(cfile, FO_READ) ) != -1
mwidth = ( maxrow() + 1 ) * 2
buffer = space(mwidth)
for xx = 1 to maxcol() + 1
fread(nhandle, @buffer, mwidth)
aadd(screen_, buffer)
next
fclose(nhandle)
midpoint = int((maxcol() + 1) / 2) + 1
for xx = midpoint to maxcol() + 1
restscreen(0, xx - 1, maxrow(), xx - 1, screen_[xx])
restscreen(0, maxcol() + 1 - xx, maxrow(), ;
maxcol() + 1 - xx, screen_[maxcol() + 2 - xx])
for yy = 1 to ndelay
next
next
endif
endif
setcursor(oldcurs)
return NIL
/* End Function Pull_Drape() */
/* Function: SAVE_DRAPE()
Purpose: Save title screen to specified memory file
Excerpted from the Grumpfish Library*/
function save_drape(cfile)
local buffer, nhandle := fcreate(cfile), xx, ret_val := .f.
if ferror() = 0
ret_val = .t.
for xx = 0 to maxcol()
buffer = savescreen(0, xx, maxrow(), xx)
if fwrite(nhandle, buffer) != ( maxrow() + 1) * 2
ret_val = .f.
exit
endif
next
fclose(nhandle)
endif
return ret_val
/* End Function SAVE_DRAPE() */
/* Function: MOVEMENT()
Purpose: Resize a box with the arrow keys */
function Movement(noflicker)
local t := 10, l := 10, b := 12, r := 69, x, oldscrn, key := 0
setcursor(0)
setcolor('w/b')
/* draw bogus backdrop to prove the point */
for x = 0 to maxrow()
@ x, 0 say replicate(chr(x), maxcol() + 1)
next
oldscrn = savescreen(0, 0, maxrow(), maxcol())
setcolor('n/bg')
@ t, l, b, r box '─┐│┘─└│ '
/* first allow anchoring of top left corner */
do while key != K_ESC .and. key != K_ENTER
key = inkey(0)
do case
case key = K_LEFT .and. l > 0
l--
case key = K_RIGHT .and. l < r + 1
l++
case key = K_UP .and. t > 0
t--
case key = K_DOWN .and. t < b - 1
t++
endcase
if noflicker
beginpaint()
endif
restscreen(0, 0, maxrow(), maxcol(), oldscrn)
@ t, l, b, r box '─┐│┘─└│ '
if noflicker
endpaint()
endif
enddo
key = 0
@ t, l, b, r box '┌─┐│─└│ '
/* now allow anchoring of bottom right corner */
do while key != K_ESC .and. key != K_ENTER
key = inkey(0)
do case
case key = K_LEFT .and. r > l + 1
r--
case key = K_RIGHT .and. r < maxcol()
r++
case key = K_UP .and. b > t + 1
b--
case key = K_DOWN .and. b < maxrow()
b++
endcase
if noflicker
beginpaint()
endif
restscreen(0, 0, maxrow(), maxcol(), oldscrn)
@ t, l, b, r box '┌─┐│─└│ '
if noflicker
endpaint()
endif
enddo
return nil
/* End Function MOVEMENT()
/************** End of Program VIRTUAL.PRG *************/